; jmc-lisp-fp-demo.cl

; Tested with GNU CLISP
; http://clisp.cons.org/

; http://www.paulgraham.com/rootsoflisp.html
; http://lib.store.yahoo.net/lib/paulgraham/jmc.lisp

(load "jmc.lisp")

(defparameter a
 '((db 
    (((content) (foo))
     ((more content) (bar))
     ((yet more content) (foo bar))
     ))
   (tag-query
    (lambda (tags db)
     (filter '(lambda (item) (tagsq tags item)) db)))
   (tagsq
    (lambda (query-tags item)
     (subset query-tags (car (cdr item)))))
   (memq 
    (lambda (key lat)
     (cond ((eq lat '()) '())
           ((eq key (car lat)) 't)
           ('t (memq key (cdr lat))))))
   (subset 
    (lambda (keys lat)
     (cond ((eq keys '()) 't)
           ((memq (car keys) lat) (subset (cdr keys) lat))
           ('t '()))))
   (filter 
    (lambda (f l)
     (cond ((eq l '()) '())
           ((f (car l)) (cons (car l) (filter f (cdr l))))
           ('t (filter f (cdr l))))))
   (map 
    (lambda (f l)
     (cond ((eq l '()) '())
            ('t (cons (f (car l)) (map f (cdr l)))))))
   (subst  
    (lambda (x y z)
     (cond ((atom z)
      (cond ((eq z y) x)
             ('t z)))
      ('t (cons (subst x y (car z))
                (subst x y (cdr z)))))))
  )
)

(print (list
 (equal
  (eval. '(tag-query '(foo) db) a)     ; expression to evaluate
  '(((content) (foo)) ((yet more content) (foo bar))) ; expected result
 )
 (equal
  (eval. '(map 'car (tag-query '(foo) db)) a)
  '((content) (yet more content))
 )
))
